home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / errorsys.zip / ERRORSYS.PRG < prev   
Text File  |  1993-01-04  |  4KB  |  154 lines
  1. ***  ERRORSYS.PRG
  2. ***  Nantucket Corporation
  3. ***  Modifications made by Greg Lief 8/89 - 9/89
  4. ***  Modifications made by Kevin Harrison 9/30/89
  5. ***  This is basically the same as the ALTERROR.PRG provided by
  6. ***  Nantucket.  Printer errors are recoverable, and if a "divide by
  7. ***  zero" is detected, a zero will be returned so as not to crash
  8. ***  your hard-working program.  However, all other errors are (and
  9. ***  SHOULD be) considered non-recoverable.  For such errors, I display
  10. ***  a pleasant box on the screen (as opposed to the terse one-line
  11. ***  message that usually appears at row 0).  I also reprint the error
  12. ***  information, along with the current date and time, to the file
  13. ***  ERROR.TXT.  This file is appended, so numerous error messages may
  14. ***  be written to disk.  Hope it helps you out!
  15. FUNCTION print_error
  16. PARAM name, line
  17. PRIVATE key, file
  18.  
  19. SET DEVICE TO SCREEN
  20. @ 0, 0
  21. @ 0, 0 SAY "Proc " + M->name + " line " + LTRIM(STR(M->line)) +;
  22.             ", printer not ready"
  23. @ 1, 0 SAY "Press <I>gnore, <R>etry, <B>REAK, F<ile>, <Q>uit..."
  24.  
  25. DO WHILE .T.
  26.     key = UPPER(CHR(INKEY(0)))
  27.  
  28.     IF (M->key == "Q")
  29.         QUIT
  30.  
  31.     ELSEIF (M->key == "I")
  32.         @ 0,0
  33.         @ 1,0
  34.         RETURN .F.
  35.  
  36.     ELSEIF (M->key == "R")
  37.         @ 0,0
  38.         @ 1,0
  39.         RETURN .T.
  40.  
  41.     ELSEIF (M->key == "B")
  42.         @ 0,0
  43.         @ 1,0
  44.         BREAK
  45.  
  46.     ELSEIF (M->key == "F")
  47.         @ 0, 0
  48.         @ 1,0
  49.         ACCEPT "Filename - " TO file
  50.         SET PRINTER TO (M->file)
  51.         @ 0,0
  52.         @ 1,0
  53.         RETURN .T.
  54.  
  55.     END
  56. END
  57.  
  58. RETURN .F.
  59.  
  60.  
  61. ***  Expression Errors
  62. *
  63. function expr_error
  64. parameters name, line, info, model, _1, _2, _3
  65.  
  66. ** return 0 if zero divide error
  67. IF M->info = "zero divide"
  68.    RETURN (IF("%" $ M->model, M->_1, 0))
  69. ENDIF
  70.  
  71. goofed("Proc " +M->name +" line " +ltrim(str(M->line)) +", " +M->info)
  72. return .f.
  73.  
  74. ***  Undefined Symbol Errors
  75. *
  76. function undef_error
  77. parameters name, line, info, model, _1
  78. goofed("Proc " +M->name +" line " +ltrim(str(M->line)) + ", " +M->info +" " +M->_1)
  79. return .f.
  80.  
  81. ***  Miscellaneous Errors
  82. *
  83. function misc_error
  84. parameters name, line, info, model
  85. goofed("Proc " +M->name +" line " +ltrim(str(M->line)) +", " +M->info)
  86. return .f.
  87.  
  88. ***  File Open Errors
  89. *
  90. function open_error
  91. parameters name, line, info, model, _1
  92.  
  93. * for network users this code is in clippers errorsys and is required to
  94. *loop back to the users net_use() if trying to open an exclusively used file
  95. *OPEN ERROR 5 on a use  can than be handled as a normal file busy locked error
  96.  
  97. IF NETERR() .AND. model == "USE"
  98.         RETURN .F.
  99. ENDIF
  100.  
  101. goofed("Proc " +M->name +" line " +ltrim(str(M->line)) + ;
  102.        ", " +M->info +" " +M->_1 +" (" +ltrim(str(DOSERROR())) +")")
  103. return .f.
  104.  
  105. ***  Database Errors
  106. *
  107. function db_error
  108. parameters name, line, info
  109. private buffer, handle
  110. goofed("Proc " +M->name +" line " +ltrim(str(M->line)) +", " +M->info)
  111. return .f.
  112.  
  113. function goofed
  114. param msg
  115. set device to screen
  116. set color to +w/r
  117. @ 10, 8, 13, 72  BOX '┌─┐│┘─└│ '
  118. @ 11, 10 SAY 'A system error has occurred - please consult your programmer'
  119. TONE(880,1)
  120. TONE(440,1)
  121. TONE(220,1)
  122. TONE(110,1)
  123. do while .t.
  124. if ! file('error.txt')
  125.    handle = fcreate('error.txt')
  126.    if ferror()=4    && if out of handles close databases,loop and retry
  127.       close databases
  128.       loop
  129.    endif
  130.    exit
  131. else
  132.    handle = fopen('error.txt', 2)
  133.    if ferror()=4
  134.       close databases
  135.       loop
  136.    endif
  137.    fseek(handle, 0, 2)   && move to end of file
  138.    exit
  139. endif
  140. enddo
  141. buffer = 'System Error: ' + msg + CHR(13) + CHR(10) + ;
  142.   'Date: ' + DTOC(DATE()) + '   Time: ' + TIME() +'  User: ' + netname() + CHR(13) + CHR(10) +;
  143.    REPLICATE('-',80) + CHR(13) + CHR(10)
  144. fwrite(handle, buffer)
  145. fclose(handle)
  146. inkey(0)
  147. set cursor on
  148. set color to
  149. clear
  150. quit
  151. return .f.
  152.  
  153. * EOF: ErrorSys.Prg
  154.